home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / Qbnddlg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  7.5 KB  |  293 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit QBndDlg;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18. uses
  19.   SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  20.   Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB
  21.   {$IFNDEF RX_D4}, DBTables {$ENDIF};
  22.  
  23. type
  24.   TQueryParamsDialog = class(TForm)
  25.     GroupBox1: TGroupBox;
  26.     Label1: TLabel;
  27.     ParamValue: TEdit;
  28.     Label2: TLabel;
  29.     NullValue: TCheckBox;
  30.     OkBtn: TButton;
  31.     CancelBtn: TButton;
  32.     Label3: TLabel;
  33.     TypeList: TComboBox;
  34.     ParamList: TListBox;
  35.     HelpBtn: TButton;
  36.     procedure ParamListChange(Sender: TObject);
  37.     procedure TypeListChange(Sender: TObject);
  38.     procedure ParamValueExit(Sender: TObject);
  39.     procedure NullValueClick(Sender: TObject);
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure OkBtnClick(Sender: TObject);
  42.     procedure HelpBtnClick(Sender: TObject);
  43.   private
  44.     InitList: TParams;
  45.     PressedOK: Boolean;
  46.     InValueExit: Boolean;
  47.     InParamChange: Boolean;
  48.     procedure CheckValue;
  49.     procedure Edit;
  50.     procedure Unbind;
  51.   end;
  52.  
  53. function EditQueryParams(DataSet: TDataSet; List: TParams;
  54.   AHelpContext: THelpContext {$IFDEF RX_D4} = 0 {$ENDIF}): Boolean;
  55.  
  56. implementation
  57.  
  58. uses DbConsts, {$IFDEF RX_D3} BdeConst, {$ENDIF} VclUtils;
  59.  
  60. {$R *.DFM}
  61.  
  62. var
  63.   FieldTypes: array[TFieldType] of String;
  64.  
  65. procedure FillFieldTypes;
  66. var
  67.   ParamString: string;
  68.   I: Integer;
  69.   J: TFieldType;
  70. begin
  71.   for J := Low(TFieldType) to High(TFieldType) do
  72.     FieldTypes[J] := EmptyStr;
  73.   ParamString := ResStr(SDataTypes);
  74.   J := Low(TFieldType);
  75.   I := 1;
  76.   while I <= Length(ParamString) do begin
  77.     FieldTypes[J] := ExtractFieldName(ParamString, I);
  78.     Inc(J);
  79.   end;
  80. end;
  81.  
  82. function GetFieldType(const Value: string): TFieldType;
  83. begin
  84.   for Result := Low(TFieldType) to High(TFieldType) do
  85.     if (FieldTypes[Result] <> '') and (FieldTypes[Result] = Value) then Exit;
  86.   Result := ftUnknown;
  87. end;
  88.  
  89. procedure ClearFieldTypes;
  90. var
  91.   I: TFieldType;
  92. begin
  93.   for I := Low(TFieldType) to High(TFieldType) do begin
  94.     //DisposeStr(FieldTypes[I]);
  95.     FieldTypes[I] := EmptyStr;
  96.   end;
  97. end;
  98.  
  99. procedure DoneQBind; far;
  100. begin
  101.   ClearFieldTypes;
  102. end;
  103.  
  104. function EditQueryParams(DataSet: TDataSet; List: TParams;
  105.   AHelpContext: THelpContext {$IFDEF RX_D4} = 0 {$ENDIF}): Boolean;
  106. begin
  107.   with TQueryParamsDialog.Create(Application) do
  108.   try
  109.     HelpContext := AHelpContext;
  110.     if HelpContext = 0 then begin
  111.       HelpBtn.Visible := False;
  112.       OkBtn.Left := OkBtn.Left + HelpBtn.Width div 2;
  113.       CancelBtn.Left := CancelBtn.Left + HelpBtn.Width div 2;
  114.     end;
  115.     if (csDesigning in DataSet.ComponentState) then
  116.       Caption := Format(ResStr(SParamEditor),
  117. {$IFDEF RX_D3}
  118.   {$IFDEF CBUILDER}
  119.         [DataSet.Owner.Name, '->', DataSet.Name]);
  120.   {$ELSE}
  121.     {$IFDEF RX_D4}
  122.         [DataSet.Owner.Name, '.', DataSet.Name]);
  123.     {$ELSE}
  124.         [DataSet.Owner.Name, DataSet.Name]);
  125.     {$ENDIF}
  126.   {$ENDIF}
  127. {$ELSE}
  128.         [DataSet.Owner.Name, DataSet.Name]);
  129. {$ENDIF}
  130.     InitList := List;
  131.     Edit;
  132.     Result := PressedOk;
  133.   finally
  134.     Free;
  135.   end;
  136. end;
  137.  
  138. procedure TQueryParamsDialog.Edit;
  139. var
  140.   I: Integer;
  141.   J: TFieldType;
  142. begin
  143.   for J := Low(TFieldType) to High(TFieldType) do
  144.     if (FieldTypes[J] <> '') and (FieldTypes[J] <> '') then TypeList.Items.Add(FieldTypes[J]);
  145.   if InitList.Count = 0 then begin
  146.     ParamValue.Enabled := False;
  147.     NullValue.Enabled := False;
  148.     TypeList.Enabled := False;
  149.     ParamList.Enabled := False;
  150.   end
  151.   else begin
  152.     for I := 0 to InitList.Count - 1 do
  153.       if ParamList.Items.IndexOf(InitList[I].Name) = -1 then
  154.         ParamList.Items.Add(InitList[I].Name);
  155.     ParamList.ItemIndex := 0;
  156.     ParamListChange(Self);
  157.     ActiveControl := OkBtn;
  158.   end;
  159.   PressedOk := ShowModal = mrOK;
  160. end;
  161.  
  162. procedure TQueryParamsDialog.ParamListChange(Sender: TObject);
  163. begin
  164.   InParamChange := True;
  165.   try
  166.     with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
  167.     begin
  168.       if (FieldTypes[DataType] <> '') and (FieldTypes[DataType] <> '') then begin
  169.         with TypeList do ItemIndex := Items.IndexOf(FieldTypes[DataType]);
  170.         if Bound then ParamValue.Text := AsString
  171.         else ParamValue.Text := '';
  172.       end
  173.       else begin
  174.         TypeList.ItemIndex := -1;
  175.         ParamValue.Text := '';
  176.       end;
  177.       NullValue.Checked := IsNull;
  178.     end;
  179.   finally
  180.     InParamChange := False;
  181.   end;
  182. end;
  183.  
  184. procedure TQueryParamsDialog.TypeListChange(Sender: TObject);
  185. begin
  186.   with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
  187.   begin
  188.     DataType := GetFieldType(TypeList.Text);
  189.     ParamValue.Text := '';
  190.     NullValue.Checked := IsNull;
  191.   end;
  192. end;
  193.  
  194. procedure TQueryParamsDialog.ParamValueExit(Sender: TObject);
  195. begin
  196.   if InValueExit or (ActiveControl = CancelBtn) then Exit;
  197.   InValueExit := True;
  198.   try
  199.     if ParamValue.Text <> '' then NullValue.Checked := False;
  200.     if (TypeList.Text = '') and TypeList.CanFocus then begin
  201.       TypeList.SetFocus;
  202.       raise Exception.Create(ResStr(SInvalidParamFieldType));
  203.     end;
  204.     if ParamValue.Text = '' then
  205.       with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
  206.       begin
  207.         if NullValue.Checked then Clear
  208.         else Unbind;
  209.       end
  210.     else CheckValue;
  211.   finally
  212.     InValueExit := False;
  213.   end;
  214. end;
  215.  
  216. procedure TQueryParamsDialog.CheckValue;
  217. begin
  218.   try
  219.     with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do begin
  220.       if (DataType in [ftDate, ftTime, ftDateTime]) and
  221.         (CompareText(ParamValue.Text, 'Now') = 0) then
  222.       begin
  223.         case DataType of
  224.           ftDate: Text := DateToStr(SysUtils.Date);
  225.           ftTime: Text := TimeToStr(SysUtils.Time);
  226.           ftDateTime: Text := DateTimeToStr(SysUtils.Now);
  227.         end;
  228.       end
  229.       else Text := ParamValue.Text;
  230.     end;
  231.   except
  232.     with ParamValue do begin
  233.       if CanFocus then SetFocus;
  234.       SelectAll;
  235.     end;
  236.     raise;
  237.   end;
  238. end;
  239.  
  240. procedure TQueryParamsDialog.Unbind;
  241. begin
  242.   with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
  243.   begin
  244.     AsInteger := 1;
  245.     DataType := GetFieldType(TypeList.Text);
  246.     Bound := False;
  247.   end;
  248. end;
  249.  
  250. procedure TQueryParamsDialog.NullValueClick(Sender: TObject);
  251. begin
  252.   if InParamChange then Exit;
  253.   if NullValue.Checked then
  254.     with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
  255.     begin
  256.       Clear;
  257.       ParamValue.Text := '';
  258.     end
  259.   else Unbind;
  260. end;
  261.  
  262. procedure TQueryParamsDialog.OkBtnClick(Sender: TObject);
  263. begin
  264.   if not TypeList.Enabled then Exit;
  265.   try
  266.     ParamValueExit(Sender);
  267.   except
  268.     ModalResult := 0;
  269.     raise;
  270.   end;
  271. end;
  272.  
  273. procedure TQueryParamsDialog.HelpBtnClick(Sender: TObject);
  274. begin
  275.   Application.HelpContext(HelpContext);
  276. end;
  277.  
  278. procedure TQueryParamsDialog.FormCreate(Sender: TObject);
  279. begin
  280. {$IFNDEF WIN32}
  281.   Font.Style := [fsBold];
  282. {$ENDIF}
  283. end;
  284.  
  285. initialization
  286.   FillFieldTypes;
  287. {$IFDEF WIN32}
  288. finalization
  289.   DoneQBind;
  290. {$ELSE}
  291.   AddExitProc(DoneQBind);
  292. {$ENDIF}
  293. end.